Programming Microsoft Visual Basic .NET/Programming Microsoft Visual Basic .NET (Microsoft Press)(X08-78517)(2002).bin/05 inheritance/inheritancedemo/module1.vb

Text File | 2002-03-20 | 8.6 KB | 262 lines

Module MainModule

    Sub Main()
        ' Run one of the Textxxxx procedures below by uncommenting only one statement

        'TestInheritance()
        'TestInheritance2()
        'TestInheritance3()
        'TestInheritance4()
        'TestOverridablePerformance()
        'TestMyClassKeyword()
        'TestMemberShadowing()
        'TestShadows()
        'TestShadows2()
        'TestProtectedScope()
        'TestProtectedScope2()
        'TestTrapEvents()
        'TestTrapEvents2()

        ' You need these statements when running inside Visual Studio, so that
        ' the Console window doesn't disappear
        Console.WriteLine("")
        Console.WriteLine(">>> press Enter to terminate the program <<<")
        Console.ReadLine()

    End Sub

    ' This procedure test basic inheritance

    Sub TestInheritance()
        Dim e As New Employee()
        e.FirstName = "Joe"
        e.LastName = "Doe"
        ' This assignment always works.
        Dim p As Person = e
        ' This proves that p points to the Employee object.
        Console.WriteLine(p.CompleteName)    '=> Joe Doe
    End Sub

    ' This procedure demonstrate event inheritance.

    Dim WithEvents anEmployee As Employee

    Sub TestInheritance2()
        ' Create the event sink.
        anEmployee = New Employee()
        anEmployee.FirstName = "Joe"
        anEmployee.LastName = "Doe"

        ' Notify this employee that he got new mail.
        ' (This indirectly raises the event.)
        anEmployee.NotifyNewMail("Message from VB2TheMax")
    End Sub

    ' The event procedure
    Sub Employee_NewMail(ByVal msgText As String) Handles anEmployee.GotMail
        Console.WriteLine("NEW MAIL: " & msgText)
    End Sub

    ' this procedure demonstrates shared member inheritance.

    Sub TestInheritance3()
        Dim e1 As New Employee()
        e1.FirstName = "Joe"
        e1.LastName = "Doe"

        Dim e2 As New Employee()
        e2.FirstName = "Robert"
        e2.LastName = "Doe"

        Dim e3 As New Employee()
        e3.FirstName = "Ann"
        e3.LastName = "Doe"

        ' Joe is Robert's and Ann's father.
        e2.Father = e1
        e3.Father = e1
        ' Call the inherited shared method in the Employee class.
        Console.WriteLine(Employee.AreBrothers(e2, e3))    ' => True
    End Sub

    ' this procedure tests derived classes with non-default constructors

    Sub TestInheritance4()
        ' create an Employee without a Title.
        Dim e1 As New Employee2("Joe", "Doe")
        Console.WriteLine(e1.CompleteName)     ' => Joe Doe

        ' create an Employee with a Title.
        Dim e2 As New Employee2("Joe", "Doe", "Mr.")
        Console.WriteLine(e2.CompleteName)     ' => Mr. Joe Doe
    End Sub

    ' this procedure benchmarks NotOverridable and Overridable methods
    ' run this code with Start without Debugging (Ctrl+F5) to see the
    ' best results.

    Sub TestOverridablePerformance()
        Const Times As Integer = 200000000

        Dim t As Date
        Dim i As Integer
        Dim sum As Integer
        Dim w As New Widget()

        ' benchmark calls to non-overridable method.
        t = Now
        For i = 1 To Times
            sum += w.GetInteger
        Next
        Console.WriteLine("Non-overridable method: {0} secs.", Now.Subtract(t))

        ' benchmark calls to overridable method.
        t = Now
        For i = 1 To Times
            sum += w.GetInteger2
        Next
        Console.WriteLine("Overridable method: {0} secs.", Now.Subtract(t))

        ' benchmark calls to a method in the class interface.
        t = Now
        For i = 1 To Times
            w.Dispose()
        Next
        Console.WriteLine("Method in class interface: {0} secs.", Now.Subtract(t))

        ' benchmark calls to a method in an interface.
        Dim d As IDisposable = CType(w, IDisposable)
        t = Now
        For i = 1 To Times
            d.Dispose()
        Next
        Console.WriteLine("Method in an interface: {0} secs.", Now.Subtract(t))
    End Sub

    ' this procedure shows which kind of problem you can solve with the MyClass keyword.

    Sub TestMyClassKeyword()
        Dim e As New Employee3("Joe", "Doe")
        e.Gender = Gender.Male
        ' the TitledName method in Person3 (base class) uses the
        ' overridden version of Title property in Employee3 (derived class).
        Console.WriteLine(e.TitledName)     ' => Mr. Joe Doe

        ' Create a person and an employee.
        Dim p2 As New Person3("Joe", "Doe")
        Dim e2 As New Employee3("Robert", "Smith")
        ' They are born on the same day.
        p2.BirthDate = #12/31/1983#
        e2.BirthDate = #12/31/1983#
        ' (Assuming that you run this code in year 2001...)
        ' The person can't vote yet (correct).

        Console.WriteLine(p2.CanVote)          ' => False
        ' The employee appears to be allowed to vote (incorrect).
        Console.WriteLine(e2.CanVote)          ' => True

        ' the CanVote2 procedure returns correct values because it relies on the MyClass keyword
        Console.WriteLine(e2.CanVote2)         ' => False
    End Sub

    ' this procedure tests member shadowing

    Sub TestMemberShadowing()
        Dim b As New BBB()
        b.DoSomething()
        b.DoSomething("abc")
        b.DoSomething2()
        b.DoSomething2("abc")
    End Sub

    ' this procedure tests the Shadows keyword

    Sub TestShadows()
        ' create a Person3 object
        Dim p As New Person3("Joe", "Doe")
        ' show that you can assign a null string to its Address property
        ' without raising any error
        p.Address = ""

        ' create an Employee object
        Dim e As New Employee3("Ann", "Doe")
        ' demonstrates that the Employee overrides the (non-overridable) Address property.
        Try
            ' NOTE: next statement throws an exception: this proves that the Employee3 class
            '       has overridden the Address property to provide a more robust implementation.
            e.Address = ""
        Catch ex As Exception
            Console.WriteLine("An exception occurred: " & ex.Message)
        End Try
    End Sub

    Sub TestShadows2()
        Dim e As New Employee3("Joe", "Doe")

        Try
            ' This statement correctly raises an ArgumentException,
            ' because of the code in the Employee class
            e.Address = ""
        Catch ex As Exception
            Console.WriteLine("An exception occurred: " & ex.Message)
        End Try

        ' Access the same object through a base class variable.
        Dim p As Person3 = e
        ' This raises no runtime error, because the Address property procedure
        ' in the base class is actually executed.
        p.Address = ""
    End Sub

    ' these procedures demonstate the Protected keyword.

    Sub TestProtectedScope()
        Dim c1 As New Customer()
        Dim c2 As New GoodCustomer()
        Console.WriteLine(c1.TotalOrderAmount(10000, 100))   ' => 9100
        Console.WriteLine(c2.TotalOrderAmount(10000, 100))   ' => 8600
    End Sub

    ' this procedure tests the Protected scope

    Sub TestProtectedScope2()
        Dim c3 As New ForeignCustomer(False)    ' ill-behaved
        Dim c4 As New ForeignCustomer(True)     ' well-behaved

        Console.WriteLine(c3.TotalOrderAmount(10000, 400))   ' => 9400
        Console.WriteLine(c4.TotalOrderAmount(10000, 400))   ' => 8500
    End Sub

    ' this procedure shows how a derived class can trap events defined in its base class

    Dim WithEvents fdr As New FileDataReader()

    Sub TestTrapEvents()
        ' cause a DataAvailable event to be fired - this event is fired in the next procedure
        fdr.GetNewData()
    End Sub

    Public Sub DataAvailableEvent() Handles fdr.DataAvailable
        Console.WriteLine("DataAvailable event")
    End Sub

    ' this procedure shows how a derived class can trap AND control events defined
    ' in its base class

    Dim WithEvents fdr2 As New FileDataReader2()

    Sub TestTrapEvents2()
        ' prove that the derived class can prevent the base class from rising the event
        Dim i As Integer
        ' only the first 10 GetNewDate methods raise a DataAvailable event
        For i = 1 To 20
            fdr2.GetNewData()
        Next
    End Sub

    Public Sub DataAvailableEvent2() Handles fdr2.DataAvailable
        Console.WriteLine("DataAvailable event #" & CStr(fdr2.EventCounter))
    End Sub
End Module